home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / srcuc.zip / X11GRAPH.C < prev    next >
C/C++ Source or Header  |  1992-05-13  |  26KB  |  806 lines
  1. /* -*-C-*-
  2.  
  3. $Header: /scheme/src/microcode/RCS/x11graph.c,v 1.26 1992/05/13 22:45:18 bal Exp $
  4.  
  5. Copyright (c) 1989-92 Massachusetts Institute of Technology
  6.  
  7. This material was developed by the Scheme project at the Massachusetts
  8. Institute of Technology, Department of Electrical Engineering and
  9. Computer Science.  Permission to copy this software, to redistribute
  10. it, and to use it for any purpose is granted, subject to the following
  11. restrictions and understandings.
  12.  
  13. 1. Any copy made of this software must include this copyright notice
  14. in full.
  15.  
  16. 2. Users of this software agree to make their best efforts (a) to
  17. return to the MIT Scheme project any improvements or extensions that
  18. they make, so that these may be included in future releases; and (b)
  19. to inform MIT of noteworthy uses of this software.
  20.  
  21. 3. All materials developed as a consequence of the use of this
  22. software shall duly acknowledge such use, in accordance with the usual
  23. standards of acknowledging credit in academic research.
  24.  
  25. 4. MIT has made no warrantee or representation that the operation of
  26. this software will be error-free, and MIT is under no obligation to
  27. provide any services, by way of maintenance, update, or otherwise.
  28.  
  29. 5. In conjunction with products arising from the use of this material,
  30. there shall be no use of the name of the Massachusetts Institute of
  31. Technology nor of any adaptation thereof in any advertising,
  32. promotional, or sales literature without prior written consent from
  33. MIT in each case. */
  34.  
  35. /* Simple graphics for X11 */
  36.  
  37. #include "scheme.h"
  38. #include "prims.h"
  39. #include "x11.h"
  40.  
  41. #define RESOURCE_NAME "schemeGraphics"
  42. #define RESOURCE_CLASS "SchemeGraphics"
  43. #define DEFAULT_GEOMETRY "512x384+0+0"
  44.  
  45. struct gw_extra
  46. {
  47.   float x_left;
  48.   float x_right;
  49.   float y_bottom;
  50.   float y_top;
  51.   float x_slope;
  52.   float y_slope;
  53.   int x_cursor;
  54.   int y_cursor;
  55. };
  56.  
  57. #define XW_EXTRA(xw) ((struct gw_extra *) ((xw) -> extra))
  58.  
  59. #define XW_X_LEFT(xw) ((XW_EXTRA (xw)) -> x_left)
  60. #define XW_X_RIGHT(xw) ((XW_EXTRA (xw)) -> x_right)
  61. #define XW_Y_BOTTOM(xw) ((XW_EXTRA (xw)) -> y_bottom)
  62. #define XW_Y_TOP(xw) ((XW_EXTRA (xw)) -> y_top)
  63. #define XW_X_SLOPE(xw) ((XW_EXTRA (xw)) -> x_slope)
  64. #define XW_Y_SLOPE(xw) ((XW_EXTRA (xw)) -> y_slope)
  65. #define XW_X_CURSOR(xw) ((XW_EXTRA (xw)) -> x_cursor)
  66. #define XW_Y_CURSOR(xw) ((XW_EXTRA (xw)) -> y_cursor)
  67.  
  68. #define ROUND_FLOAT(flonum)                        \
  69.   ((int) (((flonum) >= 0.0) ? ((flonum) + 0.5) : ((flonum) - 0.5)))
  70.  
  71. static unsigned int
  72. DEFUN (arg_x_coordinate, (arg, xw),
  73.        unsigned int arg AND
  74.        struct xwindow * xw)
  75. {
  76.   float virtual_device_x = (arg_real_number (arg));
  77.   float device_x = ((XW_X_SLOPE (xw)) * (virtual_device_x - (XW_X_LEFT (xw))));
  78.   return (ROUND_FLOAT (device_x));
  79. }
  80.  
  81. static unsigned int
  82. DEFUN (arg_y_coordinate, (arg, xw),
  83.        unsigned int arg AND
  84.        struct xwindow * xw)
  85. {
  86.   float virtual_device_y = (arg_real_number (arg));
  87.   float device_y =
  88.     ((XW_Y_SLOPE (xw)) * (virtual_device_y - (XW_Y_BOTTOM (xw))));
  89.   return (((int) ((XW_Y_SIZE (xw)) - 1)) + (ROUND_FLOAT (device_y)));
  90. }
  91.  
  92. static SCHEME_OBJECT
  93. DEFUN (x_coordinate_map, (xw, x), struct xwindow * xw AND unsigned int x)
  94. {
  95.   return
  96.     (FLOAT_TO_FLONUM ((((float) x) / (XW_X_SLOPE (xw))) + (XW_X_LEFT (xw))));
  97. }
  98.  
  99. static SCHEME_OBJECT
  100. DEFUN (y_coordinate_map, (xw, y), struct xwindow * xw AND unsigned int y)
  101. {
  102.   return
  103.     (FLOAT_TO_FLONUM
  104.      (((((float) y) - ((XW_Y_SIZE (xw)) - 1)) / (XW_Y_SLOPE (xw)))
  105.         + (XW_Y_BOTTOM (xw))));
  106. }
  107.  
  108. static void
  109. DEFUN (set_clip_rectangle, (xw, x_left, y_bottom, x_right, y_top),
  110.        struct xwindow * xw AND
  111.        unsigned int x_left AND
  112.        unsigned int y_bottom AND
  113.        unsigned int x_right AND
  114.        unsigned int y_top)
  115. {
  116.   XRectangle rectangles [1];
  117.   Display * display = (XW_DISPLAY (xw));
  118.   unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
  119.   if (x_left > x_right)
  120.     {
  121.       unsigned int x = x_left;
  122.       x_left = x_right;
  123.       x_right = x;
  124.     }
  125.   if (y_top > y_bottom)
  126.     {
  127.       unsigned int y = y_top;
  128.       y_top = y_bottom;
  129.       y_bottom = y;
  130.     }
  131.   {
  132.     unsigned int width = ((x_right + 1) - x_left);
  133.     unsigned int height = ((y_bottom + 1) - y_top);
  134.     (XW_CLIP_X (xw)) = x_left;
  135.     (XW_CLIP_Y (xw)) = y_top;
  136.     (XW_CLIP_WIDTH (xw)) = width;
  137.     (XW_CLIP_HEIGHT (xw)) = height;
  138.     ((rectangles[0]) . x) = x_left;
  139.     ((rectangles[0]) . y) = y_top;
  140.     ((rectangles[0]) . width) = width;
  141.     ((rectangles[0]) . height) = height;
  142.   }
  143.   XSetClipRectangles
  144.     (display,
  145.      (XW_NORMAL_GC (xw)),
  146.      internal_border_width,
  147.      internal_border_width,
  148.      rectangles, 1, Unsorted);
  149.   XSetClipRectangles
  150.     (display,
  151.      (XW_REVERSE_GC (xw)),
  152.      internal_border_width,
  153.      internal_border_width,
  154.      rectangles, 1, Unsorted);
  155. }
  156.  
  157. static void
  158. DEFUN (reset_clip_rectangle, (xw), struct xwindow * xw)
  159. {
  160.   set_clip_rectangle
  161.     (xw, 0, ((XW_Y_SIZE (xw)) - 1), ((XW_X_SIZE (xw)) - 1), 0);
  162. }
  163.  
  164. static void
  165. DEFUN (reset_virtual_device_coordinates, (xw), struct xwindow * xw)
  166. {
  167.   /* Note that the expression ((XW_c_SIZE (xw)) - 1) guarantees that
  168.      both limits of the device coordinates will be inside the window. */
  169.   (XW_X_SLOPE (xw)) =
  170.     (((float) ((XW_X_SIZE (xw)) - 1)) /
  171.      ((XW_X_RIGHT (xw)) - (XW_X_LEFT (xw))));
  172.   (XW_Y_SLOPE (xw)) =
  173.     (((float) ((XW_Y_SIZE (xw)) - 1)) /
  174.      ((XW_Y_BOTTOM (xw)) - (XW_Y_TOP (xw))));
  175.   reset_clip_rectangle (xw);
  176. }
  177.  
  178. DEFINE_PRIMITIVE ("X-GRAPHICS-SET-VDC-EXTENT", Prim_x_graphics_set_vdc_extent, 5, 5,
  179.   "(X-GRAPHICS-SET-VDC-EXTENT WINDOW X-MIN Y-MIN X-MAX Y-MAX)\n\
  180. Set the virtual device coordinates to the given values.")
  181. {
  182.   PRIMITIVE_HEADER (5);
  183.   {
  184.     struct xwindow * xw = (x_window_arg (1));
  185.     float x_left = (arg_real_number (2));
  186.     float y_bottom = (arg_real_number (3));
  187.     float x_right = (arg_real_number (4));
  188.     float y_top = (arg_real_number (5));
  189.     (XW_X_LEFT (xw)) = x_left;
  190.     (XW_Y_BOTTOM (xw)) = y_bottom;
  191.     (XW_X_RIGHT (xw)) = x_right;
  192.     (XW_Y_TOP (xw)) = y_top;
  193.     reset_virtual_device_coordinates (xw);
  194.   }
  195.   PRIMITIVE_RETURN (UNSPECIFIC);
  196. }
  197.  
  198. DEFINE_PRIMITIVE ("X-GRAPHICS-VDC-EXTENT", Prim_x_graphics_vdc_extent, 1, 1, 0)
  199. {
  200.   PRIMITIVE_HEADER (5);
  201.   {
  202.     struct xwindow * xw = (x_window_arg (1));
  203.     SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 4, true));
  204.     VECTOR_SET (result, 0, (double_to_flonum ((double) (XW_X_LEFT (xw)))));
  205.     VECTOR_SET (result, 1, (double_to_flonum ((double) (XW_Y_BOTTOM (xw)))));
  206.     VECTOR_SET (result, 2, (double_to_flonum ((double) (XW_X_RIGHT (xw)))));
  207.     VECTOR_SET (result, 3, (double_to_flonum ((double) (XW_Y_TOP (xw)))));
  208.     PRIMITIVE_RETURN (result);
  209.   }
  210. }
  211.  
  212. DEFINE_PRIMITIVE ("X-GRAPHICS-RESET-CLIP-RECTANGLE", Prim_x_graphics_reset_clip_rectangle, 1, 1, 0)
  213. {
  214.   PRIMITIVE_HEADER (1);
  215.   reset_clip_rectangle (x_window_arg (1));
  216.   PRIMITIVE_RETURN (UNSPECIFIC);
  217. }
  218.  
  219. DEFINE_PRIMITIVE ("X-GRAPHICS-SET-CLIP-RECTANGLE", Prim_x_graphics_set_clip_rectangle, 5, 5,
  220.   "(X-GRAPHICS-SET-CLIP-RECTANGLE WINDOW X-LEFT Y-BOTTOM X-RIGHT Y-TOP)\n\
  221. Set the clip rectangle to the given coordinates.")
  222. {
  223.   PRIMITIVE_HEADER (5);
  224.   {
  225.     struct xwindow * xw = (x_window_arg (1));
  226.     set_clip_rectangle
  227.       (xw,
  228.        (arg_x_coordinate (2, xw)),
  229.        (arg_y_coordinate (3, xw)),
  230.        (arg_x_coordinate (4, xw)),
  231.        (arg_y_coordinate (5, xw)));
  232.   }
  233.   PRIMITIVE_RETURN (UNSPECIFIC);
  234. }
  235.  
  236. static void
  237. DEFUN (process_event, (xw, event),
  238.        struct xwindow * xw AND
  239.        XEvent * event)
  240. {
  241.   switch (event -> type)
  242.     {
  243.     case ConfigureNotify:
  244.       {
  245.     unsigned int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
  246.     unsigned int x_size = (((event -> xconfigure) . width) - extra);
  247.     unsigned int y_size = (((event -> xconfigure) . height) - extra);
  248.     if ((x_size != (XW_X_SIZE (xw))) || (y_size != (XW_Y_SIZE (xw))))
  249.       {
  250.         (XW_X_SIZE (xw)) = x_size;
  251.         (XW_Y_SIZE (xw)) = y_size;
  252.         reset_virtual_device_coordinates (xw);
  253.         XClearWindow ((XW_DISPLAY (xw)), (XW_WINDOW (xw)));
  254.       }
  255.       }
  256.       break;
  257.     }
  258. }
  259.  
  260. static void
  261. DEFUN (wm_set_size_hint, (xw, geometry_mask, x, y),
  262.        struct xwindow * xw AND
  263.        int geometry_mask AND
  264.        int x AND
  265.        int y)
  266. {
  267.   unsigned int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
  268.   XSizeHints * size_hints = (XAllocSizeHints ());
  269.   if (size_hints == 0)
  270.     error_external_return ();
  271.   (size_hints -> flags) =
  272.     (PResizeInc | PMinSize | PBaseSize
  273.      | (((geometry_mask & XValue) && (geometry_mask & YValue))
  274.     ? USPosition : PPosition)
  275.      | (((geometry_mask & WidthValue) && (geometry_mask & HeightValue))
  276.     ? USSize : PSize));
  277.   (size_hints -> x) = x;
  278.   (size_hints -> y) = y;
  279.   (size_hints -> width) = ((XW_X_SIZE (xw)) + extra);
  280.   (size_hints -> height) = ((XW_Y_SIZE (xw)) + extra);
  281.   (size_hints -> width_inc) = 1;
  282.   (size_hints -> height_inc) = 1;
  283.   (size_hints -> min_width) = extra;
  284.   (size_hints -> min_height) = extra;
  285.   (size_hints -> base_width) = extra;
  286.   (size_hints -> base_height) = extra;
  287.   XSetWMNormalHints ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), size_hints);
  288.   XFree ((caddr_t) size_hints);
  289. }
  290.  
  291. DEFINE_PRIMITIVE ("X-GRAPHICS-OPEN-WINDOW", Prim_x_graphics_open_window, 3, 3,
  292.   "(X-GRAPHICS-OPEN-WINDOW DISPLAY GEOMETRY SUPPRESS-MAP?)\n\
  293. Open a window on DISPLAY using GEOMETRY.\n\
  294. If GEOMETRY is false map window interactively.\n\
  295. If third argument SUPPRESS-MAP? is true, do not map the window immediately.")
  296. {
  297.   PRIMITIVE_HEADER (3);
  298.   {
  299.     struct xdisplay * xd = (x_display_arg (1));
  300.     Display * display = (XD_DISPLAY (xd));
  301.     struct drawing_attributes attributes;
  302.     struct xwindow_methods methods;
  303.     XSetWindowAttributes wattributes;
  304.     CONST char * resource_name = RESOURCE_NAME;
  305.     CONST char * resource_class = RESOURCE_CLASS;
  306.     int map_p;
  307.  
  308.     x_decode_window_map_arg
  309.       ((ARG_REF (3)), (&resource_name), (&resource_class), (&map_p));
  310.     x_default_attributes
  311.       (display, resource_name, resource_class, (&attributes));
  312.     (wattributes . background_pixel) = (attributes . background_pixel);
  313.     (wattributes . border_pixel) = (attributes . border_pixel);
  314.     (wattributes . backing_store) = Always;
  315.     (methods . deallocator) = 0;
  316.     (methods . event_processor) = process_event;
  317.     (methods . x_coordinate_map) = x_coordinate_map;
  318.     (methods . y_coordinate_map) = y_coordinate_map;
  319.     (methods . update_normal_hints) = 0;
  320.     {
  321.       unsigned int extra = (2 * (attributes . internal_border_width));
  322.       int x_pos = (-1);
  323.       int y_pos = (-1);
  324.       int x_size = 512;
  325.       int y_size = 384;
  326.       int geometry_mask =
  327.     (XGeometry (display, (DefaultScreen (display)),
  328.             (((ARG_REF (2)) == SHARP_F)
  329.              ? (x_get_default
  330.             (display, resource_name, resource_class,
  331.              "geometry", "Geometry", 0))
  332.              : (STRING_ARG (2))),
  333.             DEFAULT_GEOMETRY, (attributes . border_width),
  334.             1, 1, extra, extra,
  335.             (&x_pos), (&y_pos), (&x_size), (&y_size)));
  336.       Window window =
  337.     (XCreateWindow
  338.      (display,
  339.       (RootWindow (display, (DefaultScreen (display)))),
  340.       x_pos, y_pos, (x_size + extra), (y_size + extra),
  341.       (attributes . border_width),
  342.       CopyFromParent, CopyFromParent, CopyFromParent,
  343.       (CWBackPixel | CWBorderPixel | CWBackingStore),
  344.       (&wattributes)));
  345.       if (window == 0)
  346.     error_external_return ();
  347.       {
  348.     struct xwindow * xw =
  349.       (x_make_window
  350.        (xd, window, x_size, y_size, (&attributes), (&methods),
  351.         (sizeof (struct gw_extra))));
  352.     (XW_X_LEFT (xw)) = ((float) (-1));
  353.     (XW_X_RIGHT (xw)) = ((float) 1);
  354.     (XW_Y_BOTTOM (xw)) = ((float) (-1));
  355.     (XW_Y_TOP (xw)) = ((float) 1);
  356.     reset_virtual_device_coordinates (xw);
  357.     (XW_X_CURSOR (xw)) = 0;
  358.     (XW_Y_CURSOR (xw)) = 0;
  359.     wm_set_size_hint (xw, geometry_mask, x_pos, y_pos);
  360.     xw_set_wm_input_hint (xw, 0);
  361.     xw_set_wm_name (xw, "scheme-graphics");
  362.     xw_set_wm_icon_name (xw, "scheme-graphics");
  363.     XSelectInput (display, window, StructureNotifyMask);
  364.     xw_make_window_map (xw, resource_name, resource_class, map_p);
  365.     PRIMITIVE_RETURN (XW_TO_OBJECT (xw));
  366.       }
  367.     }
  368.   }
  369. }
  370.  
  371. DEFINE_PRIMITIVE ("X-GRAPHICS-DRAW-LINE", Prim_x_graphics_draw_line, 5, 5,
  372.   "(X-GRAPHICS-DRAW-LINE WINDOW X-START Y-START X-END Y-END)\n\
  373. Draw a line from the start coordinates to the end coordinates.\n\
  374. Subsequently move the graphics cursor to the end coordinates.")
  375. {
  376.   PRIMITIVE_HEADER (5);
  377.   {
  378.     struct xwindow * xw = (x_window_arg (1));
  379.     unsigned int new_x_cursor = (arg_x_coordinate (4, xw));
  380.     unsigned int new_y_cursor = (arg_y_coordinate (5, xw));
  381.     unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
  382.     XDrawLine
  383.       ((XW_DISPLAY (xw)),
  384.        (XW_WINDOW (xw)),
  385.        (XW_NORMAL_GC (xw)),
  386.        (internal_border_width + (arg_x_coordinate (2, xw))),
  387.        (internal_border_width + (arg_y_coordinate (3, xw))),
  388.        (internal_border_width + new_x_cursor),
  389.        (internal_border_width + new_y_cursor));
  390.     (XW_X_CURSOR (xw)) = new_x_cursor;
  391.     (XW_Y_CURSOR (xw)) = new_y_cursor;
  392.   }
  393.   PRIMITIVE_RETURN (UNSPECIFIC);
  394. }
  395.  
  396. DEFINE_PRIMITIVE ("X-GRAPHICS-MOVE-CURSOR", Prim_x_graphics_move_cursor, 3, 3,
  397.   "(X-GRAPHICS-MOVE-CURSOR WINDOW X Y)\n\
  398. Move the graphics cursor to the given coordinates.")
  399. {
  400.   PRIMITIVE_HEADER (3);
  401.   {
  402.     struct xwindow * xw = (x_window_arg (1));
  403.     (XW_X_CURSOR (xw)) = (arg_x_coordinate (2, xw));
  404.     (XW_Y_CURSOR (xw)) = (arg_y_coordinate (3, xw));
  405.   }
  406.   PRIMITIVE_RETURN (UNSPECIFIC);
  407. }
  408.  
  409. DEFINE_PRIMITIVE ("X-GRAPHICS-DRAG-CURSOR", Prim_x_graphics_drag_cursor, 3, 3,
  410.   "(X-GRAPHICS-DRAG-CURSOR WINDOW X Y)\n\
  411. Draw a line from the graphics cursor to the given coordinates.\n\
  412. Subsequently move the graphics cursor to those coordinates.")
  413. {
  414.   PRIMITIVE_HEADER (3);
  415.   {
  416.     struct xwindow * xw = (x_window_arg (1));
  417.     unsigned int new_x_cursor = (arg_x_coordinate (2, xw));
  418.     unsigned int new_y_cursor = (arg_y_coordinate (3, xw));
  419.     unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
  420.     XDrawLine
  421.       ((XW_DISPLAY (xw)),
  422.        (XW_WINDOW (xw)),
  423.        (XW_NORMAL_GC (xw)),
  424.        (internal_border_width + (XW_X_CURSOR (xw))),
  425.        (internal_border_width + (XW_Y_CURSOR (xw))),
  426.        (internal_border_width + new_x_cursor),
  427.        (internal_border_width + new_y_cursor));
  428.     (XW_X_CURSOR (xw)) = new_x_cursor;
  429.     (XW_Y_CURSOR (xw)) = new_y_cursor;
  430.   }
  431.   PRIMITIVE_RETURN (UNSPECIFIC);
  432. }
  433.  
  434. DEFINE_PRIMITIVE ("X-GRAPHICS-DRAW-POINT", Prim_x_graphics_draw_point, 3, 3,
  435.   "(X-GRAPHICS-DRAW-POINT WINDOW X Y)\n\
  436. Draw one point at the given coordinates.\n\
  437. Subsequently move the graphics cursor to those coordinates.")
  438. {
  439.   PRIMITIVE_HEADER (3);
  440.   {
  441.     struct xwindow * xw = (x_window_arg (1));
  442.     unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
  443.     XDrawPoint
  444.       ((XW_DISPLAY (xw)),
  445.        (XW_WINDOW (xw)),
  446.        (XW_NORMAL_GC (xw)),
  447.        (internal_border_width + (arg_x_coordinate (2, xw))),
  448.        (internal_border_width + (arg_y_coordinate (3, xw))));
  449.   }
  450.   PRIMITIVE_RETURN (UNSPECIFIC);
  451. }
  452.  
  453. DEFINE_PRIMITIVE ("X-GRAPHICS-DRAW-STRING", Prim_x_graphics_draw_string, 4, 4,
  454.   "(X-GRAPHICS-DRAW-STRING WINDOW X Y STRING)\n\
  455. Draw characters in the current font at the given coordinates.")
  456. {
  457.   PRIMITIVE_HEADER (4);
  458.   {
  459.     struct xwindow * xw = (x_window_arg (1));
  460.     unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
  461.     char * s = (STRING_ARG (4));
  462.     XDrawString
  463.       ((XW_DISPLAY (xw)),
  464.        (XW_WINDOW (xw)),
  465.        (XW_NORMAL_GC (xw)),
  466.        (internal_border_width + (arg_x_coordinate (2, xw))),
  467.        (internal_border_width + (arg_y_coordinate (3, xw))),
  468.        s,
  469.        (STRING_LENGTH (ARG_REF (4))));
  470.   }
  471.   PRIMITIVE_RETURN (UNSPECIFIC);
  472. }
  473.  
  474. DEFINE_PRIMITIVE ("X-GRAPHICS-SET-FUNCTION", Prim_x_graphics_set_function, 2, 2, 0)
  475. {
  476.   PRIMITIVE_HEADER (2);
  477.   {
  478.     struct xwindow * xw = (x_window_arg (1));
  479.     Display * display = (XW_DISPLAY (xw));
  480.     unsigned int function = (arg_index_integer (2, 16));
  481.     XSetFunction (display, (XW_NORMAL_GC (xw)), function);
  482.     XSetFunction (display, (XW_REVERSE_GC (xw)), function);
  483.   }
  484.   PRIMITIVE_RETURN (UNSPECIFIC);
  485. }
  486.  
  487. DEFINE_PRIMITIVE ("X-GRAPHICS-SET-FILL-STYLE", Prim_x_graphics_set_fill_style, 2, 2, 0)
  488. {
  489.   PRIMITIVE_HEADER (2);
  490.   {
  491.     struct xwindow * xw = (x_window_arg (1));
  492.     Display * display = (XW_DISPLAY (xw));
  493.     unsigned int fill_style = (arg_index_integer (2, 4));
  494.     XSetFillStyle (display, (XW_NORMAL_GC (xw)), fill_style);
  495.     XSetFillStyle (display, (XW_REVERSE_GC (xw)), fill_style);
  496.   }
  497.   PRIMITIVE_RETURN (UNSPECIFIC);
  498. }
  499.  
  500. DEFINE_PRIMITIVE ("X-GRAPHICS-SET-LINE-STYLE", Prim_x_graphics_set_line_style, 2, 2, 0)
  501. {
  502.   PRIMITIVE_HEADER (2);
  503.   {
  504.     struct xwindow * xw = (x_window_arg (1));
  505.     Display * display = (XW_DISPLAY (xw));
  506.     unsigned int style = (arg_index_integer (2, 3));
  507.     XSetLineAttributes
  508.       (display, (XW_NORMAL_GC (xw)), 0, style, CapButt, JoinMiter);
  509.     XSetLineAttributes
  510.       (display, (XW_REVERSE_GC (xw)), 0, style, CapButt, JoinMiter);
  511.   }
  512.   PRIMITIVE_RETURN (UNSPECIFIC);
  513. }
  514.  
  515. DEFINE_PRIMITIVE ("X-GRAPHICS-SET-DASHES", Prim_x_graphics_set_dashes, 3, 3, 0)
  516. {
  517.   PRIMITIVE_HEADER (3);
  518.   {
  519.     struct xwindow * xw = (x_window_arg (1));
  520.     Display * display = (XW_DISPLAY (xw));
  521.     char * dash_list = (STRING_ARG (3));
  522.     unsigned int dash_list_length = (STRING_LENGTH (ARG_REF (3)));
  523.     unsigned int dash_offset = (arg_index_integer (2, dash_list_length));
  524.     XSetDashes
  525.       (display, (XW_NORMAL_GC (xw)), dash_offset, dash_list, dash_list_length);
  526.     XSetDashes
  527.       (display, (XW_REVERSE_GC (xw)), dash_offset, dash_list,
  528.        dash_list_length);
  529.   }
  530.   PRIMITIVE_RETURN (UNSPECIFIC);
  531. }
  532.  
  533. DEFINE_PRIMITIVE ("X-GRAPHICS-COPY-AREA", Prim_x_graphics_copy_area, 7, 7, 0)
  534. {
  535.   PRIMITIVE_HEADER (7);
  536.   {
  537.     struct xwindow * xw = x_window_arg (1);
  538.     unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
  539.     float device_width = ((XW_X_SLOPE (xw)) * (arg_real_number (4)));
  540.     float device_height = ((XW_Y_SLOPE (xw)) * (arg_real_number (5)));
  541.  
  542.     XCopyArea ((XW_DISPLAY (xw)),
  543.            (XW_WINDOW (xw)),
  544.            (XW_WINDOW (xw)),
  545.            (XW_NORMAL_GC (xw)),
  546.            (internal_border_width + (arg_x_coordinate (2, xw))),
  547.            (internal_border_width + (arg_y_coordinate (3, xw))),
  548.            (ROUND_FLOAT (device_width)),
  549.            (ROUND_FLOAT (device_height)),
  550.            (internal_border_width + (arg_x_coordinate (6, xw))),
  551.            (internal_border_width + (arg_y_coordinate (7, xw))));
  552.     PRIMITIVE_RETURN (UNSPECIFIC);
  553.   }
  554. }
  555.  
  556. static XPoint *
  557. DEFUN (x_polygon_vector_arg, (xw, argno),
  558.        struct xwindow * xw AND
  559.        unsigned int argno)
  560. {
  561.   SCHEME_OBJECT vector = (VECTOR_ARG (argno));
  562.   unsigned long length = (VECTOR_LENGTH (vector));
  563.   unsigned int border = (XW_INTERNAL_BORDER_WIDTH (xw));
  564.   if ((length % 2) != 0)
  565.     error_bad_range_arg (argno);
  566.   {
  567.     XPoint * result = (x_malloc ((length / 2) * (sizeof (XPoint))));
  568.     XPoint * scan_result = result;
  569.     SCHEME_OBJECT * scan = (& (VECTOR_REF (vector, 0)));
  570.     SCHEME_OBJECT * end = (scan + length);
  571.     SCHEME_OBJECT coord;
  572.     while (scan < end)
  573.       {
  574.     coord = (*scan++);
  575.     if (! ((REAL_P (coord)) && (real_number_to_double_p (coord))))
  576.       error_bad_range_arg (argno);
  577.     {
  578.       double dx =
  579.         ((XW_X_SLOPE (xw))
  580.          * ((real_number_to_double (coord)) - (XW_X_LEFT (xw))));
  581.       (scan_result -> x) = (border + (ROUND_FLOAT (dx)));
  582.     }
  583.     coord = (*scan++);
  584.     if (! ((REAL_P (coord)) && (real_number_to_double_p (coord))))
  585.       error_bad_range_arg (argno);
  586.     {
  587.       double dy =
  588.         ((XW_Y_SLOPE (xw))
  589.          * ((real_number_to_double (coord)) - (XW_Y_BOTTOM (xw))));
  590.       (scan_result -> y) = (((XW_Y_SIZE (xw)) - 1) + (ROUND_FLOAT (dy)));
  591.     }
  592.     scan_result += 1;
  593.       }
  594.     return (result);
  595.   }
  596. }
  597.  
  598. DEFINE_PRIMITIVE ("X-GRAPHICS-FILL-POLYGON", Prim_x_graphics_fill_polygon, 2, 2, 0)
  599. {
  600.   PRIMITIVE_HEADER (2);
  601.   {
  602.     struct xwindow * xw = x_window_arg (1);
  603.     XPoint * points = (x_polygon_vector_arg (xw, 2));
  604.     unsigned long length = VECTOR_LENGTH (VECTOR_ARG (2));
  605.     XFillPolygon ((XW_DISPLAY (xw)),
  606.           (XW_WINDOW (xw)),
  607.           (XW_NORMAL_GC (xw)),
  608.           points,
  609.           (length / 2),
  610.           Nonconvex,
  611.           CoordModeOrigin);
  612.     free (points);
  613.     PRIMITIVE_RETURN (UNSPECIFIC);
  614.   }
  615. }
  616.  
  617. DEFINE_PRIMITIVE ("X-CREATE-IMAGE", Prim_x_create_image, 3, 3,
  618.   "Arguments: Window, width, height\n\
  619. Returns:   A Scheme image\n\
  620. \n\
  621. The window is used to find the Display, Visual, and Depth\n\
  622. information needed to crate an XImage structure.")
  623. {
  624.   PRIMITIVE_HEADER (3);
  625.   {
  626.     struct xwindow * xw = (x_window_arg (1));
  627.     Window window = (XW_WINDOW (xw));
  628.     Display * dpy = (XW_DISPLAY (xw));
  629.     unsigned int width = (arg_nonnegative_integer (2));
  630.     unsigned int height = (arg_nonnegative_integer (3));
  631.     unsigned int bitmap_pad = (BitmapPad (dpy));
  632.     unsigned int byte_pad = (bitmap_pad / CHAR_BIT);
  633.     unsigned int bytes_per_line =
  634.       (((width + (byte_pad - 1)) / byte_pad) * byte_pad);
  635.     XWindowAttributes attrs;
  636.     XGetWindowAttributes (dpy, window, (&attrs));
  637.     PRIMITIVE_RETURN
  638.       (X_IMAGE_TO_OBJECT
  639.        (XCreateImage
  640.     (dpy,
  641.      (DefaultVisualOfScreen (attrs . screen)),
  642.      (attrs . depth),
  643.      ZPixmap,
  644.      0,
  645.      ((char *)
  646.       (x_malloc (height
  647.              * bytes_per_line
  648.              * ((((attrs . depth) - 1) / 8) + 1)))),
  649.      width,
  650.      height,
  651.      bitmap_pad,
  652.      bytes_per_line)));
  653.   }
  654. }
  655.  
  656. DEFINE_PRIMITIVE ("X-BYTES-INTO-IMAGE", Prim_x_bytes_into_image, 2, 2,
  657.   "Stick the bytes from the vector-8b (first arg) into the x_image (second arg).")
  658. {
  659.   PRIMITIVE_HEADER (2);
  660.   {
  661.     SCHEME_OBJECT vector = ARG_REF (1);
  662.     XImage * image = XI_IMAGE (x_image_arg (2));
  663.     char * image_scan;
  664.     unsigned long width = (image -> width);
  665.     unsigned long height = (image -> height);
  666.     int x, y;
  667.  
  668.     if (! (STRING_P (vector)))
  669.       error_wrong_type_arg (1);
  670.     if (STRING_LENGTH(vector) != (width * height))
  671.       error_bad_range_arg (1);
  672.  
  673.     image_scan = ((char *) STRING_LOC (vector, 0));
  674.     for (y = 0; y < height; y++)
  675.       for (x = 0; x < width; x++)
  676.     XPutPixel (image, x, y, ((unsigned long) *image_scan++));
  677.     PRIMITIVE_RETURN (UNSPECIFIC);
  678.   }
  679. }
  680.  
  681. DEFINE_PRIMITIVE("X-GET-PIXEL-FROM-IMAGE", Prim_x_get_image_pixel, 3, 3, 0)
  682. {
  683.   PRIMITIVE_HEADER (3);
  684.   {
  685.     XImage * image = (XI_IMAGE (x_image_arg (1)));
  686.     PRIMITIVE_RETURN
  687.       (long_to_integer
  688.        (XGetPixel (image,
  689.            (arg_index_integer (2, (image -> width))),
  690.            (arg_index_integer (3, (image -> height))))));
  691.   }
  692. }
  693.  
  694. DEFINE_PRIMITIVE("X-SET-PIXEL-IN-IMAGE", Prim_x_set_image_pixel, 4, 4, 0)
  695. {
  696.   PRIMITIVE_HEADER (4);
  697.   {
  698.     XImage * image = (XI_IMAGE (x_image_arg (1)));
  699.     XPutPixel (image,
  700.            (arg_index_integer (2, (image -> width))),
  701.            (arg_index_integer (3, (image -> height))),
  702.            (arg_integer (4)));
  703.     PRIMITIVE_RETURN (UNSPECIFIC);
  704.   }
  705. }
  706.  
  707. DEFINE_PRIMITIVE ("X-DESTROY-IMAGE", Prim_x_destroy_image, 1, 1, 0)
  708. {
  709.   PRIMITIVE_HEADER (1);
  710.   {
  711.     struct ximage * xi = (x_image_arg (1));
  712.     XDestroyImage (XI_IMAGE (xi));
  713.     deallocate_x_image (xi);
  714.     PRIMITIVE_RETURN (UNSPECIFIC);
  715.   }
  716. }
  717.  
  718. DEFINE_PRIMITIVE ("X-DISPLAY-IMAGE", Prim_x_display_image, 8, 8, 0)
  719. {
  720.   /* Called with Image, X-offset in image, Y-offset in image,
  721.      Window, X-offset in window, Y-offset in window,
  722.      Width, Height */
  723.   PRIMITIVE_HEADER (8);
  724.   {
  725.     XImage * image = (XI_IMAGE (x_image_arg (1)));
  726.     unsigned int image_width = (image -> width);
  727.     unsigned int image_height = (image -> height);
  728.     unsigned int x_offset = (arg_index_integer (2, image_width));
  729.     unsigned int y_offset = (arg_index_integer (3, image_height));
  730.     struct xwindow * xw = (x_window_arg (4));
  731.     XPutImage
  732.       ((XW_DISPLAY (xw)),(XW_WINDOW (xw)),(XW_NORMAL_GC (xw)),
  733.        image, x_offset, y_offset,
  734.        (arg_x_coordinate (5, xw)),
  735.        (arg_y_coordinate (6, xw)),
  736.        (arg_index_integer (7, ((image_width - x_offset) + 1))),
  737.        (arg_index_integer (8, ((image_height - y_offset) + 1))));
  738.     PRIMITIVE_RETURN (UNSPECIFIC);
  739.   }
  740. }
  741.  
  742. DEFINE_PRIMITIVE ("X-READ-IMAGE", Prim_x_read_image, 8, 8, 0)
  743. {
  744.   /* Called with Image, X-offset in image, Y-offset in image,
  745.      Window, X-offset in window, Y-offset in window,
  746.      Width, Height */
  747.   PRIMITIVE_HEADER (8);
  748.   { struct ximage * xi = x_image_arg (1);
  749.     long XImageOffset = arg_integer(2);
  750.     long YImageOffset = arg_integer(3);
  751.     struct xwindow * xw = x_window_arg(4);
  752.     long XWindowOffset = arg_integer(5);
  753.     long YWindowOffset = arg_integer(6);
  754.     long Width = arg_integer(7);
  755.     long Height = arg_integer(8);
  756.  
  757.     XGetSubImage(XW_DISPLAY(xw), XW_WINDOW(xw), XWindowOffset, YWindowOffset,
  758.          Width, Height, -1, ZPixmap,
  759.          XI_IMAGE(xi), XImageOffset, YImageOffset);
  760.     PRIMITIVE_RETURN (UNSPECIFIC);
  761.   }
  762. }
  763.  
  764. DEFINE_PRIMITIVE ("X-WINDOW-DEPTH", Prim_x_window_depth, 1, 1, 0)
  765. {
  766.   PRIMITIVE_HEADER (1);
  767.   {
  768.     struct xwindow * xw = (x_window_arg (1));
  769.     XWindowAttributes attrs;
  770.     XGetWindowAttributes ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (&attrs));
  771.     PRIMITIVE_RETURN (long_to_integer (attrs . depth));
  772.   }
  773. }
  774.  
  775. DEFINE_PRIMITIVE ("X-GRAPHICS-MAP-X-COORDINATE", Prim_x_graphics_map_x_coordinate, 2, 2, 0)
  776. {
  777.   PRIMITIVE_HEADER (2);
  778.   {
  779.     struct xwindow * xw = (x_window_arg (1));
  780.     unsigned int xp = (arg_nonnegative_integer (2));
  781.     int bx = (xp - (XW_INTERNAL_BORDER_WIDTH (xw)));
  782.     PRIMITIVE_RETURN
  783.       (x_coordinate_map
  784.        (xw,
  785.     ((bx < 0) ? 0
  786.      : (bx >= (XW_X_SIZE (xw))) ? ((XW_X_SIZE (xw)) - 1)
  787.      : bx)));
  788.   }
  789. }
  790.  
  791. DEFINE_PRIMITIVE ("X-GRAPHICS-MAP-Y-COORDINATE", Prim_x_graphics_map_y_coordinate, 2, 2, 0)
  792. {
  793.   PRIMITIVE_HEADER (2);
  794.   {
  795.     struct xwindow * xw = (x_window_arg (1));
  796.     unsigned int yp = (arg_nonnegative_integer (2));
  797.     int by = (yp - (XW_INTERNAL_BORDER_WIDTH (xw)));
  798.     PRIMITIVE_RETURN
  799.       (y_coordinate_map
  800.        (xw,
  801.     ((by < 0) ? 0
  802.      : (by >= (XW_Y_SIZE (xw))) ? ((XW_Y_SIZE (xw)) - 1)
  803.      : by)));
  804.   }
  805. }
  806.